home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tclTest.c < prev    next >
C/C++ Source or Header  |  1993-02-14  |  3KB  |  152 lines
  1. /* 
  2.  * tclTest.c --
  3.  *
  4.  *    Test driver for TCL.
  5.  *
  6.  * Copyright 1987-1991 Regents of the University of California
  7.  * All rights reserved.
  8.  *
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appears in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #include <stdio.h>
  19. #include <errno.h>
  20. #include <string.h>
  21. #include <stdlib.h>
  22. #include "tcl.h"
  23.  
  24. Tcl_Interp *interp;
  25. Tcl_CmdBuf buffer;
  26. char dumpFile[100];
  27. int quitFlag = 0;
  28.  
  29. char initCmd[] =
  30.     "if [file exists [info library]/init.tcl] {source [info library]/init.tcl}";
  31.  
  32.     /* ARGSUSED */
  33. int
  34. cmdCheckmem(clientData, interp, argc, argv)
  35.     ClientData clientData;
  36.     Tcl_Interp *interp;
  37.     int argc;
  38.     char *argv[];
  39. {
  40.     if (argc != 2) {
  41.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  42.         " fileName\"", (char *) NULL);
  43.     return TCL_ERROR;
  44.     }
  45.     strcpy(dumpFile, argv[1]);
  46.     quitFlag = 1;
  47.     return TCL_OK;
  48. }
  49.  
  50.     /* ARGSUSED */
  51. int
  52. cmdEcho(clientData, interp, argc, argv)
  53.     ClientData clientData;
  54.     Tcl_Interp *interp;
  55.     int argc;
  56.     char *argv[];
  57. {
  58.     int i;
  59.  
  60.     for (i = 1; ; i++) {
  61.     if (argv[i] == NULL) {
  62.         if (i != argc) {
  63.         echoError:
  64.         sprintf(interp->result,
  65.             "argument list wasn't properly NULL-terminated in \"%s\" command",
  66.             argv[0]);
  67.         }
  68.         break;
  69.     }
  70.     if (i >= argc) {
  71.         goto echoError;
  72.     }
  73.     fputs(argv[i], stdout);
  74.     if (i < (argc-1)) {
  75.         printf(" ");
  76.     }
  77.     }
  78.     printf("\n");
  79.     return TCL_OK;
  80. }
  81.  
  82. int
  83. main()
  84. {
  85.     char line[1000], *cmd;
  86.     int result, gotPartial;
  87.  
  88.     interp = Tcl_CreateInterp();
  89. #ifdef TCL_MEM_DEBUG
  90.     Tcl_InitMemory(interp);
  91. #endif
  92.     Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
  93.         (Tcl_CmdDeleteProc *) NULL);
  94.     Tcl_CreateCommand(interp, "checkmem", cmdCheckmem, (ClientData) 0,
  95.         (Tcl_CmdDeleteProc *) NULL);
  96.     buffer = Tcl_CreateCmdBuf();
  97. #ifndef TCL_GENERIC_ONLY
  98.     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
  99.     if (result != TCL_OK) {
  100.     printf("%s\n", interp->result);
  101.     exit(1);
  102.     }
  103. #endif
  104.  
  105.     gotPartial = 0;
  106.     while (1) {
  107.     clearerr(stdin);
  108.     if (!gotPartial) {
  109.         fputs("% ", stdout);
  110.         fflush(stdout);
  111.     }
  112.     if (fgets(line, 1000, stdin) == NULL) {
  113.         if (!gotPartial) {
  114.         exit(0);
  115.         }
  116.         line[0] = 0;
  117.     }
  118.     cmd = Tcl_AssembleCmd(buffer, line);
  119.     if (cmd == NULL) {
  120.         gotPartial = 1;
  121.         continue;
  122.     }
  123.  
  124.     gotPartial = 0;
  125.     result = Tcl_RecordAndEval(interp, cmd, 0);
  126.     if (result == TCL_OK) {
  127.         if (*interp->result != 0) {
  128.         printf("%s\n", interp->result);
  129.         }
  130.         if (quitFlag) {
  131.         Tcl_DeleteInterp(interp);
  132.         Tcl_DeleteCmdBuf(buffer);
  133. #ifdef TCL_MEM_DEBUG
  134.         Tcl_DumpActiveMemory(dumpFile);
  135. #endif
  136.         exit(0);
  137.         }
  138.     } else {
  139.         if (result == TCL_ERROR) {
  140.         printf("Error");
  141.         } else {
  142.         printf("Error %d", result);
  143.         }
  144.         if (*interp->result != 0) {
  145.         printf(": %s\n", interp->result);
  146.         } else {
  147.         printf("\n");
  148.         }
  149.     }
  150.     }
  151. }
  152.